(ns btree.operations
	(:use [btree.common])
    (:import [com.google.gson Gson GsonBuilder])
)

(defn modifyTree 
	"zmienia wartosc na stronie drzewa o id=pageId i kluczu key (:keys :children :parent) na val."
	[tree pageId key val]
	(assoc tree pageId (assoc (get tree pageId) key val))
)

(defn getFromTree 
	"zwraca wartosc na stronie drzewa o id=pageId i kluczu key (:keys :children :parent) na val."
	[tree pageId key]
	(get (get tree pageId) key)
)

(defn incNextIdInTree
	"zwieksza pole nextIndex, zwraca nowe drzewo"
	[tree]
	(assoc tree :nextId (inc (get tree :nextId)))
)

(defn setRootInTree
	"zwieksza pole nextIndex, zwraca nowe drzewo"
	[tree newRoot]
	(assoc tree :root newRoot)
)

(defn updateParentInChildren
	"ustawia pole 'parent' w dzieciach strony na numer tej strony"
	[tree pageId]
	(def children (getFromTree tree pageId :children))
	(defn setParent 
		[ptree pageIds value]
		(if (empty? pageIds) 
			ptree
			(if (get ptree (first pageIds)) (setParent (modifyTree ptree (first pageIds) :parent value) (rest pageIds) value) ptree )
		)
	)
	(setParent tree children pageId)
)

(defn adjust ;według: http://www.cs.uofs.edu/~mccloske/courses/cmps340/btree_alg.pdf
	"adjust tree if it is overflowing"
	[tree pageId]
	
	(def size (get tree :pageSize))
	
	(defn isOverflowing [page] (> (count (get page :keys)) (* size 2)))
	(defn isUnderflowing [page] (< (count (get page :keys)) size))
	(defn isFull [page] (= (count (get page :keys)) (* size 2)))
	(defn isOnVergeOfUnderflowing [page] (= (count (get page :keys)) size))
	
	(def parentId (get (get tree pageId) :parent))
	(if (not (nil? parentId)) (do
		(def parent (get tree parentId))
		(def indexInParent (.indexOf (get parent :children) pageId) ) ;leftSiblingPageId
	) (do
		(def parent nil)
		(def indexInParent nil)
	))
	(if (and (notnil? indexInParent) (> indexInParent 0))
		(def leftSiblingPageId (nth (get parent :children) (dec indexInParent)))
		(def leftSiblingPageId nil)
	)	
	(if (and (notnil? indexInParent) (< indexInParent (count (get parent :keys))))
		(def rightSiblingPageId (nth (get parent :children) (inc indexInParent)))
		(def rightSiblingPageId nil)
	)
	
	(defn lr-redistribuate 
		[ptree pageId indexInParent rightSiblingPageId parentId parent]		
		(def pageKeys (getFromTree ptree pageId :keys)) 
		(def siblingKeys (getFromTree ptree rightSiblingPageId :keys))
		(def parentKeys (get parent :keys))
		(def lastKey (last pageKeys))
		(def pageKeys (into [] (butlast pageKeys)))
		(def keyInParent (nth parentKeys indexInParent))
		(def parentKeys (assoc parentKeys indexInParent lastKey))
		(def siblingKeys (into [] (concat [keyInParent] siblingKeys)))
		
		(def restree ptree)
		
		(if (not (empty? (getFromTree ptree pageId :children))) ;jesli nie jest lisciem, popraw tez dzieci
			(do
				(def pageChildren (getFromTree ptree pageId :children))
				(def siblingChildren (getFromTree ptree rightSiblingPageId :children))
				(def lastChild (last pageChildren))
				(def pageChildren (into [] (butlast pageChildren)))
				(def siblingChildren (into [] (concat [lastChild] siblingChildren)))
				(def restree (modifyTree restree pageId :children pageChildren))
				(def restree (modifyTree restree rightSiblingPageId :children siblingChildren))
			)
		)
		
		(def restree (modifyTree restree pageId :keys pageKeys))
		(def restree (modifyTree restree rightSiblingPageId :keys siblingKeys))
		(def restree (modifyTree restree parentId :keys parentKeys))
		restree
	)
	
	(defn rl-redistribuate 
		[ptree pageId indexInParent leftSiblingPageId parentId parent]
		(def pageKeys (getFromTree ptree pageId :keys)) 
		(def siblingKeys (getFromTree ptree leftSiblingPageId :keys))
		(def parentKeys (get parent :keys))
		(def firstKey (first pageKeys))
		(def pageKeys (into [] (rest pageKeys)))
		(def keyInParent (nth parentKeys (dec indexInParent)))
		(def parentKeys (assoc parentKeys (dec indexInParent) firstKey))
		(def siblingKeys (into [] (concat siblingKeys [keyInParent])))
		
		(def restree ptree)
		(if (not (empty? (getFromTree ptree pageId :children))) ;jesli nie jest lisciem, popraw tez dzieci
			(do
				(def pageChildren (getFromTree ptree pageId :children))
				(def siblingChildren (getFromTree ptree leftSiblingPageId :children))
				(def firstChild (first pageChildren))
				(def pageChildren (into [] (rest pageChildren)))
				(def siblingChildren (into [] (concat siblingChildren [firstChild])))
				(def restree (modifyTree restree pageId :children pageChildren))
				(def restree (modifyTree restree leftSiblingPageId :children siblingChildren))
			)
		)
		
		(def restree (modifyTree restree pageId :keys pageKeys))
		(def restree (modifyTree restree leftSiblingPageId :keys siblingKeys))
		(def restree (modifyTree restree parentId :keys parentKeys))
		restree
	)
	
	(defn split
		[ptree pageId pindexInParent pparentId pparent]
		(def pageKeys (getFromTree ptree pageId :keys))
		(if (not= (mod (count pageKeys) 2) 1) (throw (Exception. "split called on page with even number od elements!"))) ;error - this should never happen!
		(def parentKeys (get pparent :keys))
		(def pageKeysLeft (into [] (take-1st-half pageKeys)))
		(def pageKeysRight (into [] (take-2nd-half pageKeys)))
		(def parentChildren (get pparent :children))
		(if (not (empty? (getFromTree ptree pageId :children)))
			(do
				(def pageChildren (getFromTree ptree pageId :children))
				(def pageChildrenLeft (into [] (take-1st-half pageChildren)))
				(def pageChildrenRight (into [] (take-2nd-half pageChildren)))
			)
			(do
				(def pageChildrenLeft [])
				(def pageChildrenRight [])
			)
		)
		(if (nil? pparent) (do ;jesli jestesmy w roocie	
			(def indexInParent 0)
			(def parentKeys [])
			(def parentChildren [pageId])
			(def parentId (inc (get ptree :nextId)))
		) (do
			(def indexInParent pindexInParent)
			(def parent pparent)
			(def parentId pparentId)
		))
		(def parentKeys (into [] (insert-at parentKeys indexInParent (take-middle-element pageKeys))))
		(def nextId (get ptree :nextId))
		(def parentChildren (into [] (insert-at parentChildren (inc indexInParent) nextId)))
		(def newPageLeft {:keys pageKeysLeft :children pageChildrenLeft :parent parentId})
		(def newPageRight {:keys pageKeysRight :children pageChildrenRight :parent parentId})
		
		(def restree ptree)
		(def restree (assoc restree pageId newPageLeft))
		(def restree (assoc restree nextId newPageRight))
		(def restree (updateParentInChildren restree nextId))
		(if (nil? parent) (do
			(def parent { :keys parentKeys :children parentChildren :parent nil })
			(def restree (assoc restree parentId parent))
			(def restree (assoc restree :root parentId))
			(def restree (incNextIdInTree restree))
			(def restree (updateParentInChildren restree nextId))
		) (do			
			(def restree (modifyTree restree parentId :keys parentKeys))
			(def restree (modifyTree restree parentId :children parentChildren))
		))
		(def restree (incNextIdInTree restree))
		
		restree
	)
	
	(defn concatenate
		[ptree parentId indexInParent]
		(def parentChildren (getFromTree ptree parentId :children))
		(def parentKeys (getFromTree ptree parentId :keys))
		(def leftChildId (nth parentChildren indexInParent))
		(def rightChildId (nth parentChildren (inc indexInParent)))
		(def newChild { 
			:keys (into [] (concat (getFromTree tree leftChildId :keys) [(nth parentKeys indexInParent)] (getFromTree tree rightChildId :keys)))
			:children (into [] (concat (getFromTree tree leftChildId :children) (getFromTree tree rightChildId :children))) 
			:parent parentId
		})
		(def restree ptree)		
		(def restree (modifyTree restree parentId :keys (remove-at parentKeys indexInParent)))
		(def restree (modifyTree restree parentId :children (remove-at parentChildren (inc indexInParent))))
		(def restree (assoc restree leftChildId newChild))
		(def restree (dissoc restree rightChildId))
		
		restree
	)
	
	(def rtree tree)
	(if (isOverflowing (get rtree pageId)) 
		(do ;progn
			(if (and (notnil? rightSiblingPageId) (not (isFull (get rtree rightSiblingPageId)))) ;(get (nth rtree rightSiblingPageId) :keys))) )
				(def rtree (lr-redistribuate rtree pageId indexInParent rightSiblingPageId parentId parent))
				(if (and (notnil? leftSiblingPageId) (not (isFull (get rtree leftSiblingPageId))));(get (nth rtree leftSiblingPageId) :keys))) )
					(def rtree (rl-redistribuate rtree pageId indexInParent leftSiblingPageId parentId parent))
					(do
						(def rtree (split rtree pageId indexInParent parentId parent))
						(adjust rtree parentId) 
					)
				)
			)
		) ;isOverflowing
		(if (isUnderflowing (get rtree pageId))  ; jesli undeflow i nie jest rootem
			(if (and (notnil? leftSiblingPageId) (not (isOnVergeOfUnderflowing (get rtree leftSiblingPageId)))) ;(get (nth rtree rightSiblingPageId) :keys))) )
				(def rtree (lr-redistribuate rtree leftSiblingPageId (dec indexInParent) pageId parentId parent))
				(if (and (notnil? rightSiblingPageId) (not (isOnVergeOfUnderflowing (get rtree rightSiblingPageId)))) (do ;(get (nth rtree leftSiblingPageId) :keys))) )
					(def rtree (rl-redistribuate rtree rightSiblingPageId (inc indexInParent) pageId parentId parent))
					) (if (nil? parentId) 
						(if (= (count (getFromTree rtree pageId :children)) 1) (do
							(def childId (nth (getFromTree rtree pageId :children) 0))
							(def rtree (modifyTree rtree childId :parent nil))
							(def rtree (setRootInTree rtree childId))
							(def rtree (dissoc rtree pageId))
						)) 
						(if (notnil? rightSiblingPageId)
							(def rtree (adjust (concatenate rtree parentId indexInParent) parentId))
							(def rtree (adjust (concatenate rtree parentId (dec indexInParent)) parentId))
						)
					)
				)
			)
			
		) ;not isOverflowing 
	)
	
	rtree
)

(defn tree-find-tmp ;tymczasowo. napisana jak najszybciej. Jak bedziesz mial czas napisz ladniej :P
	[tree val pageId]
	(def pageKeys (getFromTree tree pageId :keys))
	(def candidate (last (filter (fn [arg] (<= arg val)) pageKeys)))
	(def index (.indexOf pageKeys candidate))
	(if (nil? index) (def index -1))
	(if (= candidate val)
		[true pageId index]
		(if (empty? (getFromTree tree pageId :children))	;jesli nie ma dzieci to jego miejsce jest zaraz po prawej od znalezionego
			[false pageId (inc index)]
			(tree-find-tmp tree val (nth (getFromTree tree pageId :children) (inc index)))
		)
	)
)

(defn tree-find
	"finds a place where a value (val) 'belongs'. Returns vector = [found? pageId indexInPage]"
	[tree val]
	(tree-find-tmp tree val (get tree :root))
)

(defn tree-add
	"adds to tree."
	[tree val]
	(def findRes (tree-find tree val))
	(if (nth findRes 0) ;wartosc juz jest w drzewie
		tree
		(do
			(if (not (empty? (getFromTree tree (nth findRes 1) :children))) (throw (Exception. "trying to place new value not in leaf!"))) ;error
			(adjust (modifyTree tree (nth findRes 1) :keys (into [] (insert-at (getFromTree tree (nth findRes 1) :keys) (nth findRes 2) val))) (nth findRes 1))
		)
	)
)

(defn tree-remove
	"removes from tree."
	[tree val]
	(defn findLeftmost
		"finds leftmost page in page children (returns the given pageId if it has no children)"
		[tree pageId]
		(if (empty? (getFromTree tree pageId :children))
			pageId
			(findLeftmost tree (nth (getFromTree tree pageId :children) 0))
		)
	)
	(def found (tree-find tree val))
	(if (nth found 0) 
		(if (empty? (getFromTree tree (nth found 1) :children)) ;jesli nie ma dzieci => jest lisciem
			(adjust (modifyTree tree (nth found 1) :keys(remove-at (getFromTree tree (nth found 1) :keys) (nth found 2))) (nth found 1))
			(do
				(def leftmostPageId (findLeftmost tree (nth (getFromTree tree (nth found 1) :children) (inc (nth found 2))))) ;najbardziej lewy potomek prawego dziecka
				(def leftmostPageKeys (getFromTree tree leftmostPageId :keys))
				(def newKeys (assoc (getFromTree tree (nth found 1) :keys) (nth found 2) (first leftmostPageKeys))) ;podmien usuwaną wartość najmniejszą w prawym poddrzewie
				(def restree tree)
				(def restree (modifyTree restree (nth found 1) :keys newKeys))
				(def restree (modifyTree restree leftmostPageId :keys (into [](rest leftmostPageKeys))))
				(adjust restree leftmostPageId)
			)
		)
		tree
	)
)

(defn tree-create
	"creates new BTree from given numbers."
	[size & args]

	(def tree {:pageSize size :root 1 :nextId 2 1 {:keys [] :children [] :parent nil}})
	
	(defn add-list 
		[tree vals]
		(if (empty? vals)
			tree
			(add-list (tree-add tree (first vals)) (rest vals))
		)
	)

	(add-list tree (into [] args))
)

(defn tree-size
  "Count number of keys in the tree"
  [tree]
  (defn tree-level-size
    [level]
    (def l (get tree level))
    (def c (count (get l :keys )))
    (if (empty? (get l :children ))
      (int c)
      (+ c (reduce + (map tree-level-size (get l :children ))))
      )
    )
  (tree-level-size (get tree :root ))
)

(defn tree-json
    "Print tree in JSON format"
    [tree]
    (defn tree-json-tmp
        ""
        [levelId level]

        (defn tree-level-json
            [levelId]
            (def l (get tree levelId))
            (print-str
;                (clojure.string/join
                        "\n\t" (-> (doto (new Gson)) (.toJson (hash-map 'node (hash-map 'id levelId 'level level 'children (get l :children )
                                                                                                    'keys (get l :keys )))))
;                        )
                )
            )
        (if (empty? (get (get tree levelId) :children ))
            (tree-level-json levelId)
            (conj (map tree-json-tmp (get (get tree levelId) :children ) (repeat (count (get (get tree levelId) :children )) (inc level)))
                  (tree-level-json levelId)
            )
        )
    )

    (def jsonmap (tree-json-tmp (get tree :root ) 1))
    (def jmap (flatten (if (seq? jsonmap) jsonmap (list jsonmap))))
    (def nodesArr (clojure.string/join "," jmap))
    (def json (print-str "\n{\n\"tree\":\n\t[" nodesArr "\n\t]\n}"))
    json
)
